home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / DBASE5 / SAMPLES.ZIP / GESTION.PRG < prev    next >
Text File  |  1994-10-12  |  5KB  |  166 lines
  1.  
  2. ******************************************************************************
  3. * NOMBRE DEL PROGRAMA:          GESTION.PRG
  4. *                               MENU PRINCIPAL
  5. *                               EJEMPLO DE SISTEMA DE APLICACION GESTION
  6. * ULTIMO CAMBIO:                24/02/93 04:00 PM
  7. * ESCRITO POR:                  BORLAND
  8. ******************************************************************************
  9.  
  10. PROCEDURE Gestión
  11.    * Definir entorno
  12.    CLEAR ALL
  13.    SET DEVELOPMENT on
  14.    SET DELIMITERS  off
  15.    SET SCOREBOARD  off
  16.    SET ESCAPE      off
  17.    SET CLOCK       off
  18.    SET STATUS      off
  19.    SET TALK        off
  20.    SET EXACT       off
  21.    SET BELL        off
  22.    SET CATALOG     off
  23.  
  24.    * Definir tecla de ayuda
  25.    ON KEY LABEL F1 DO Ayuda
  26.  
  27.         * Almacenar colores
  28.         PUBLIC c_save
  29.         c_save = SET("ATTRIBUTES")
  30.  
  31.    * Características de visualización - dependientes del hardware
  32.    IF ISCOLOR()
  33.       c_normal = "W+/B,GR+/R,B"
  34.       c_pop    = "B/W,GR+/R,W+/R"
  35.       red      = "R/W"
  36.       blue     = "B/W"
  37.       lt_blue  = "W/BG"
  38.    ELSE
  39.       STORE "W+/N,N/W" TO c_normal, c_pop
  40.       STORE "W"   TO red, blue
  41.       STORE "N/W" TO lt_blue
  42.    ENDIF
  43.  
  44.    * Definir menú de ventana
  45.    DO Main_def
  46.  
  47.    * Visualizar menú y seleccionar opciones
  48.    **mstrloop = .T.
  49.    DO WHILE BAR() <> 13
  50.       SET COLOR TO &c_normal.
  51.       CLEAR
  52.       DO Grado
  53.       SET COLOR TO &c_pop.
  54.       ACTIVATE POPUP mainmenu
  55.    ENDDO
  56.    CLOSE ALL
  57.    CLEAR
  58. RETURN
  59. *================== fin del procedimiento principal ===========================
  60.  
  61. PROCEDURE Grado
  62.    CLEAR
  63.    * Dibujar líneas y ventanas para el menú con colores para resaltar
  64.    @ 2,24 TO 5,54 DOUBLE COLOR &blue.
  65.    @ 2,24 FILL TO 5,54   COLOR &blue.
  66.    SET COLOR TO &red.
  67.    @ 3,27 SAY "A-T INDUSTRIAS DEL MUEBLE"
  68.    @ 4,26 SAY "SISTEMA DE GESTION dBASE IV"
  69.    SET COLOR TO &c_normal.
  70. RETURN
  71.  
  72. PROCEDURE Main_def
  73.    * Definir el menú de ventana principal
  74.    DEFINE POPUP mainmenu FROM 7,27 TO 22,51;
  75.      MESSAGE "Pulse la inicial de una opción del menú " + ;
  76.              "o seleccione y pulse <Return>"
  77.    DEFINE BAR  1 OF mainmenu PROMPT "=== MENU  PRINCIPAL ===" SKIP
  78.    DEFINE BAR  2 OF mainmenu PROMPT "      Ficheros:" SKIP
  79.    DEFINE BAR  3 OF mainmenu PROMPT " EMPLEADOS"
  80.    DEFINE BAR  4 OF mainmenu PROMPT " CLIENTES"
  81.    DEFINE BAR  5 OF mainmenu PROMPT " PROVEEDORES"
  82.    DEFINE BAR  6 OF mainmenu PROMPT " INVENTARIO"
  83.    DEFINE BAR  7 OF mainmenu PROMPT " ORDENES DE PEDIDO"
  84.    DEFINE BAR  8 OF mainmenu PROMPT " MOVIMIENTO DE CUENTAS"
  85.    DEFINE BAR  9 OF mainmenu PROMPT " TELEFONOS (Prefijos)"
  86.    DEFINE BAR 10 OF mainmenu PROMPT "     Utilidades:" SKIP
  87.    DEFINE BAR 11 OF mainmenu PROMPT " FACTURACION"
  88.    DEFINE BAR 12 OF mainmenu PROMPT " ARCHIVAR/RESTAURAR"
  89.    DEFINE BAR 13 OF mainmenu PROMPT " VOLVER A dBASE"
  90.    DEFINE BAR 14 OF mainmenu PROMPT " SALIR AL DOS"
  91.    ON SELECTION POPUP mainmenu DO Main
  92. RETURN
  93.  
  94. PROCEDURE Main
  95.    * ejecutar un caso según la opción elegida
  96.    DO CASE
  97.       CASE BAR() =  3
  98.          DO Empleado
  99.       CASE BAR() =  4
  100.          DO Cli
  101.       CASE BAR() =  5
  102.          DO Proveeds
  103.       CASE BAR() =  6
  104.          DO Artículo
  105.       CASE BAR() =  7
  106.          DO Pedidos
  107.       CASE BAR() =  8
  108.          DO Mov_ctas
  109.       CASE BAR() =  9
  110.          DO Prefijos
  111.       CASE BAR() =  11
  112.          DO Facturas
  113.       CASE BAR() =  12
  114.          DO Copiaseg
  115.       CASE BAR() =  13 .OR. BAR() = 14
  116.          RELEASE ALL
  117.          SET CLOCK ON
  118.          IF BAR() = 13
  119.          * Restaurar los colores del Centro de Control/punto indicativo
  120.              DO Colo_rese
  121.              RETURN TO MASTER
  122.          ELSE
  123.             QUIT
  124.          ENDIF
  125.    ENDCASE
  126. RETURN
  127.  
  128. PROCEDURE Colo_rese
  129. PRIVATE old_color, c_messages, c_Titles, c_box, c_info, c_fields
  130.  
  131. old_color = c_save
  132.  
  133. * Restaurar los colores primarios
  134. SET COLOR TO &old_color.
  135.  
  136. * Restaurar los colores secundarios
  137. old_color = STUFF(old_color, 1, AT("&",old_color)+2, "")
  138.  
  139. comma = AT(",",old_color)
  140. c_messages = LEFT(old_color, comma-1)           && Obtener color de mensajes
  141. old_color = STUFF(old_color, 1, comma, "")      && Eliminar color de mensajes
  142.  
  143. comma = AT(",",old_color)
  144. c_Titles = LEFT(old_color, comma-1)             && Obtener color de títulos
  145. old_color = STUFF(old_color, 1, comma, "")      && Eliminar color de títulos
  146.  
  147. comma = AT(",",old_color)
  148. c_box = LEFT(old_color, comma-1)                && Obtener color de cajas
  149. old_color = STUFF(old_color, 1, comma, "")      && Eliminar color de cajas
  150.  
  151. comma = AT(",",old_color)
  152. c_info = LEFT(old_color, comma-1)               && Obtener color de información
  153. old_color = STUFF(old_color, 1, comma, "")      && Eliminar color de información
  154.  
  155. comma = AT(",",old_color)
  156. c_fields = old_color                            && Obtener color de campos
  157.  
  158. SET COLOR OF MESSAGES    TO &c_messages.
  159. SET COLOR OF Titles      TO &c_Titles.
  160. SET COLOR OF BOX         TO &c_box.
  161. SET COLOR OF INFORMATION TO &c_info.
  162. SET COLOR OF FIELDS      TO &c_fields.
  163. RETURN
  164.  
  165. *** END Gestión.PRG *********************************************************
  166.